home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / sortrec.bas < prev    next >
BASIC Source File  |  1997-06-14  |  5KB  |  127 lines
  1. Attribute VB_Name = "MSortRecursive"
  2. Option Explicit
  3.  
  4. '$ Uses UTILITY.BAS
  5.  
  6. ' Recursive QuickSort algorithm
  7. Sub SortArrayRec(aTarget() As Variant, _
  8.                  Optional vFirst As Variant, Optional vLast As Variant, _
  9.                  Optional helper As ISortHelper)
  10.     Dim iFirst As Long, iLast As Long
  11.     If IsMissing(vFirst) Then iFirst = LBound(aTarget) Else iFirst = vFirst
  12.     If IsMissing(vLast) Then iLast = UBound(aTarget) Else iLast = vLast
  13.     If helper Is Nothing Then Set helper = New CSortHelper
  14.     
  15. With helper
  16.     If iFirst < iLast Then
  17.  
  18.         ' Only two elements in this subdivision; exchange if
  19.         ' they are out of order, and end recursive calls
  20.         If iLast - iFirst = 1 Then
  21.             If .Compare(aTarget(iFirst), aTarget(iLast)) > 0 Then
  22.                 .Swap aTarget(iFirst), aTarget(iLast)
  23.             End If
  24.         Else
  25.  
  26.             Dim iLo As Long, iHi As Long
  27.             ' Pick pivot element at random and move to end
  28.             .Swap aTarget(iLast), aTarget(Random(iFirst, iLast))
  29.             iLo = iFirst: iHi = iLast
  30.             Do
  31.  
  32.                 ' Move in from both sides toward pivot element
  33.                 Do While (iLo < iHi) And _
  34.                          .Compare(aTarget(iLo), aTarget(iLast)) <= 0
  35.                     iLo = iLo + 1
  36.                 Loop
  37.                 Do While (iHi > iLo) And _
  38.                          .Compare(aTarget(iHi), aTarget(iLast)) >= 0
  39.                     iHi = iHi - 1
  40.                 Loop
  41.  
  42.                 ' If you haven't reached pivot element, it means
  43.                 ' that two elements on either side are out of
  44.                 ' order, so swap them
  45.                 If iLo < iHi Then .Swap aTarget(iLo), aTarget(iHi)
  46.             Loop While iLo < iHi
  47.  
  48.             ' Move pivot element back to its proper place
  49.             .Swap aTarget(iLo), aTarget(iLast)
  50.  
  51.             ' Recursively call SortArrayRec (pass smaller
  52.             ' subdivision first to use less stack space)
  53.             If (iLo - iFirst) < (iLast - iLo) Then
  54.                 SortArrayRec aTarget(), iFirst, iLo - 1, helper
  55.                 SortArrayRec aTarget(), iLo + 1, iLast, helper
  56.             Else
  57.                 SortArrayRec aTarget(), iLo + 1, iLast, helper
  58.                 SortArrayRec aTarget(), iFirst, iLo - 1, helper
  59.             End If
  60.         End If
  61.     End If
  62. End With
  63. End Sub
  64.  
  65. ' Recursive QuickSort algorithm
  66. Sub SortCollectionRec(nTarget As Collection, _
  67.                       Optional vFirst As Variant, _
  68.                       Optional vLast As Variant, _
  69.                       Optional helper As ISortHelper)
  70.     Dim iFirst As Long, iLast As Long
  71.     If IsMissing(vFirst) Then iFirst = 1 Else iFirst = vFirst
  72.     If IsMissing(vLast) Then iLast = nTarget.Count Else iLast = vLast
  73.     If helper Is Nothing Then Set helper = New CSortHelper
  74.  
  75. With helper
  76.     If iFirst < iLast Then
  77.  
  78.         ' Only two elements in this subdivision; exchange if
  79.         ' they are out of order, and end recursive calls
  80.         If iLast - iFirst = 1 Then
  81.             If .Compare(nTarget(iFirst), nTarget(iLast)) > 0 Then
  82.                 .CollectionSwap nTarget, iFirst, iLast
  83.             End If
  84.         Else
  85.  
  86.             Dim iLo As Long, iHi As Long
  87.             ' Pick pivot element at random and move to end
  88.             .CollectionSwap nTarget, iLast, Random(iFirst, iLast)
  89.             iLo = iFirst: iHi = iLast
  90.             Do
  91.  
  92.                 ' Move in from both sides toward pivot element
  93.                 Do While (iLo < iHi) And _
  94.                     .Compare(nTarget(iLo), nTarget(iLast)) <= 0
  95.                     iLo = iLo + 1
  96.                 Loop
  97.                 Do While (iHi > iLo) And _
  98.                     .Compare(nTarget(iHi), nTarget(iLast)) >= 0
  99.                     iHi = iHi - 1
  100.                 Loop
  101.  
  102.                 ' If you haven't reached pivot element, it means
  103.                 ' that the two elements on either side are out of
  104.                 ' order, so swap them
  105.                 If iLo < iHi Then
  106.                     .CollectionSwap nTarget, iLo, iHi
  107.                 End If
  108.             Loop While iLo < iHi
  109.  
  110.             ' Move pivot element back to its proper place
  111.             .CollectionSwap nTarget, iLo, iLast
  112.  
  113.             ' Recursively call SortCollection (pass smaller
  114.             ' subdivision first to use less stack space)
  115.             If (iLo - iFirst) < (iLast - iLo) Then
  116.                 SortCollectionRec nTarget, iFirst, iLo - 1, helper
  117.                 SortCollectionRec nTarget, iLo + 1, iLast, helper
  118.             Else
  119.                 SortCollectionRec nTarget, iLo + 1, iLast, helper
  120.                 SortCollectionRec nTarget, iFirst, iLo - 1, helper
  121.             End If
  122.         End If
  123.     End If
  124. End With
  125. End Sub
  126.  
  127.